home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvcopy.exe / PICKCOPY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-18  |  24KB  |  749 lines
  1. {$X+}
  2. program PickCopy; 
  3.  
  4. {This program provides an example of how to pop out of a dialog box, open
  5. a list box containing data from a file, then copy the desired data into
  6. several input lines in the input dialog box.  The code to do this was
  7. written by Steve Schafer in response to a question by me.
  8.  
  9. I have added code that reads, displays, adds to, edits, removes or prints
  10. data in collections, stored in ASCII files.  This is modified from a demo
  11. program called Phone.pas available either on CIS or from Borland's BBS.
  12.  
  13. I was unhappy with having the data stored in an object file since it would
  14. thus be unusable without this program and thus not be amenable to revision
  15. with a simple text editor.  Having the data stored in an ASCII file rather
  16. with a stream file violates the principles of encapsulating data and code,
  17. but I love it!.
  18.  
  19. Be aware that this example shows how Steven Schafer would do the pick and
  20. copy, but he says that there are certainly other ways which would work
  21. just as well.
  22.  
  23. If you have comments or improvements, please send them along to me:
  24.  
  25. Stewart Midwinter 74670,1306.
  26.  
  27. Cheers, SAM  }
  28.  
  29. uses
  30.   Memwatch,                    {warns of unreleased heap, by J.J. Stein}
  31.                                {available on CIS Pascal Library 1      }
  32.   Drivers,Objects,Views,Menus, {Turbo Vision units                     }
  33.   Dialogs,StdDlg,MsgBox,App,   {Turbo Vision units                     }
  34.   Gadgets,                     {Turbo Vision units                     }
  35.   Dos,Crt,                     {standard Turbo Pascal units            }
  36.   SList;                       {handles editing collections            }
  37.  
  38.  
  39. const
  40.   cmNew             = 101;  { Initialise a new site file                   }
  41.   cmOpen            = 102;  { Open an existing site file, read into memory }
  42.   cmNewDialog       = 103;  { create Details-type dialog                   }
  43.   cmSiteList        = 201;  { button to open list box to pick a site       }
  44.   cmListDlg         = 107;  { command to open list box dialog              }
  45.  
  46.  { NumSites is the number of sites listed in the "Flight Details" dialog.  }
  47.  
  48.   NumSites          = 2;
  49.  
  50. type
  51.   PsiteApp = ^TsiteApp;
  52.   TsiteApp = object (TApplication)
  53.     CurrentFile: PathStr; 
  54.     HeapViewer: PHeapView;
  55.     constructor Init;
  56.     procedure NewsiteList;
  57.     procedure OpensiteList;
  58.     procedure SavesiteList;
  59.     procedure HandleEvent (var Event: TEvent); virtual;
  60.     procedure InitMenuBar; virtual;
  61.     procedure InitStatusLine; virtual;
  62.     procedure Idle; virtual;
  63.     destructor Done; virtual;
  64.     end;
  65.  
  66.   String80 = String[80];
  67.   String60 = String[60];
  68.   String40 = String[40];
  69.   String14 = String[14];
  70.  
  71.   PSiteRec = ^TSiteRec;
  72.   TSiteRec = record{object(TObject)}
  73.     FNum: Word;
  74.     FName: string40;
  75.     FLat, FLong: String14;
  76.     FInfo: String80;
  77.   end;
  78.  
  79.  { TSite is an object type designed to hold all of the information for a
  80.    site. It is a descendant of TObject so that we can store it in a
  81.    collection. }
  82.  
  83.   PLSite = ^TLSite;
  84.   TLSite = object(TObject)
  85.     LName, LLat, LLong,LInfo: PString;
  86.     constructor Init( AName: String40;
  87.                       ALat,ALong: String14;
  88.                       AInfo: String80);
  89.     destructor Done; virtual;
  90.   end;
  91.  
  92.  { TSiteCollection is a simple descendant of TSortedCollection, which
  93.    assumes that the objects contained in it are all of type TSite. The only
  94.    change is the new Compare method, which sorts the collection on the Name
  95.    field of the TSites. }
  96.  
  97.   PLSiteCollection = ^TLSiteCollection;     {contains a TLSite object}
  98.   TLSiteCollection = object(TSortedCollection)
  99.     function Compare (Key1,Key2: pointer): integer; virtual;
  100.     procedure FreeItem(Item: pointer); virtual;
  101.   end;
  102.  
  103.  { TSiteListBox is a list box which holds TSites. The GetText method knows
  104.    that the items in the list box collection are TSites, so it extracts the
  105.    Name field for display in the list box. }
  106.  
  107.   PLSiteListBox = ^TLSiteListBox;
  108.   TLSiteListBox = Object(TListBox)
  109.     function GetText (item: integer; MaxLen: integer): string; virtual;
  110.     procedure HandleEvent(var Event: TEvent); virtual;
  111.   end;
  112.  
  113.   PListDialog = ^TListDialog;
  114.   TListDialog = object(TDialog)
  115.     SitePicklist: PLSiteListBox;
  116.     SiteType: PRadioButtons;
  117.     constructor Init;
  118.   end;
  119.  
  120.  { TSiteDialog is the "Flight Details" dialog box. Note that I've added
  121.    fields corresponding to all of the input lines; this is so that they are
  122.    directly accessible from HandleEvent. }
  123.  
  124.   PSiteDialog = ^TSiteDialog;
  125.   TSiteDialog = object(TDialog)
  126.     SSiteName,SSiteLat,SSiteLong: array[0..NumSites-1] of PInputline;
  127.     constructor Init;
  128.     procedure HandleEvent(var Event:TEvent); virtual;
  129.   end;
  130.  
  131.   SCoordData          = record
  132.     SiteName:        string80;
  133.     SiteLat:         String14;
  134.     SiteLong:        String14;
  135.   end;
  136.  
  137.   DialogPtr = ^SDialogData;
  138.   SDialogData       = record      {data record for inputting coordinates}
  139.     PlaceData:       array[0..1] of SCoordData;
  140.   end;
  141.  
  142.   NamesArray = array[0..1] of string;
  143.  
  144. const
  145.   SiteDialogData:
  146.     SDialogData = (PlaceData: (
  147.                               (SiteName: ''; SiteLat: '00'; SiteLong: '000'),
  148.                               (SiteName: ''; SiteLat: '00'; SiteLong: '000')
  149.                               ));
  150.   ChosenLocn: NamesArray = ( 'Start point','Finish point');
  151.  
  152. var
  153.   siteApp: TsiteApp;          {place here or CurrentFile will not be visible}
  154.  
  155. var
  156.   TheLSiteCollection: PLSiteCollection;
  157.  
  158.  
  159. { TsiteApp methods }
  160.  
  161. constructor TsiteApp.Init;
  162. var R: TRect;
  163. begin
  164.   TApplication.Init;
  165.   RegisterObjects;
  166.   RegisterViews;
  167.   RegisterMenus;
  168.   RegisterDialogs;
  169.   RegisterApp;
  170.   Registersite;
  171.   GetExtent(R);
  172.   Dec(R.B.X);
  173.   R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  174.   HeapViewer := New(PHeapView,Init(R));
  175.   Insert(HeapViewer);
  176.   CurrentFile := '';
  177.   Messagebox( #3'Test of Data Collection &'#13+
  178.               #3'Input Dialog w/Pick List',nil,mfinformation+mfOkButton);
  179. end;
  180.  
  181. procedure TSiteApp.Idle;    {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  182. begin
  183.   TApplication.Idle;
  184.   HeapViewer^.Update;
  185. end;
  186.  
  187.  
  188.  {----------------------------- TLSite -----------------------------------}
  189.  
  190.  { TLSite.Init just takes the string values passed to it and inserts them
  191.    into the fields. Note that any blank strings are replaced with a single
  192.    space. I've done this because calling NewStr ('') returns a NIL pointer,
  193.    which can cause problems in protected mode. }
  194.  
  195. constructor TLSite.Init (AName: String40; ALat,ALong: String14; AInfo: String80);
  196. begin
  197.  TObject.Init;
  198.  if AName <> '' then LName := NewStr (AName) else LName := NewStr (' ');
  199.  if ALat  <> '' then LLat  := NewStr (ALat)  else LLat  := NewStr (' ');
  200.  if ALong <> '' then LLong := NewStr (ALong) else LLong := NewStr (' ');
  201.  if AInfo <> '' then LInfo := NewStr (AInfo) else LInfo := NewStr (' ');
  202.  end;
  203.  
  204.  { TSite.Done simply releases the memory allocated in TSite.Init. }
  205.  
  206. destructor TLSite.Done;
  207. begin
  208.  DisposeStr (LName);
  209.  DisposeStr (LLat);
  210.  DisposeStr (LLong);
  211.  DisposeStr (LInfo);
  212.  TObject.Done;
  213. end;
  214.   {------------------------------ end of TLSite ---------------------------}
  215.  
  216.   {---------------------------- TLSiteCollection --------------------------}
  217.  
  218.  { TSiteCollection.Compare extracts the Name fields from the two items and
  219.    compares them alphabetically. }
  220.  
  221. function TLSiteCollection.Compare (Key1,Key2: Pointer): Integer;
  222. begin
  223.   if PLSite (Key1)^.LName^ < PLSite (Key2)^.LName^ then Compare := - 1
  224.   else if PLSite (Key1)^.LName^ > PLSite (Key2)^.LName^ then Compare := 1
  225.   else Compare := 0;
  226. end;
  227.  
  228. procedure TLSiteCollection.FreeItem;
  229. begin
  230.   if TheLSiteCollection <> nil then
  231.   begin
  232.   DisposeStr(PLSite(Item)^.LName);
  233.   DisposeStr(PLSite(Item)^.LLat);
  234.   DisposeStr(PLSite(Item)^.LLong);
  235.   DisposeStr(PLSite(Item)^.LInfo);
  236.   Dispose(PLSite(Item))
  237.   end;
  238. end;
  239.   {------------------------- end of TLSiteCollection ---------------------}
  240.  
  241.  
  242. { The FileExists function checks to see if the filename passed to it }
  243. { refers to an existing file.